2-2

Needs["GraphUtilities`"];

(Subscript[R, effective])[i_,j_]:=Γ[[i]][[i]]+Γ[[j]][[j]]-2Γ[[i]][[j]]

Construction of Connected Random Graphs

Nicholas Wheeler
16 November 2011

Introduction

In "Percolation Experiments 1 & 2" I attempted to address the question: How does mean internodal resistance respond when the number of resistors (edges) in a random n-node circuit (graph) is increased, from zero to the saturation value △= n(n-1)/2 ? Using the Klein-Randić method to compute internodal resistances for large samples of such random matrices, I was led to "percolation curves" of the following form:

Which presented a problem? In the complete absence of resistors the averaged internodal resistance should be infinite, not zero!

Only belatedly did I realize that the Klein-Randić method purports to work only for complete graphs, and that the small-p sector of my calculation violated that condition: graphs with only few edges are typically incomplete, and are inevitably incomplete if

I will be making essential use later of these definitions:

r[p_]:=Which[0<x<p,1,p<x<1,0]/.x->RandomReal[]

𝔸[p_]:=Table[Join[Table[0,{k,1,n}],
Table[r[p],{k,1,20-n}]],{n,1,20}]

Here it has been assumed that 𝔸 is 20 × 20; an obvious adjustment changes the dimension of 𝔸.

Some general observations

Assuming always that all resistors are unit resistors, and that no more than one resistor is allowed to connect a given pair of nodes…the maximal finite resistance on an n-node graph is

GraphPlot[(({{0, 1, 0, 0, 0, 0}, {0, 0, 1, 0, 0, 0}, {0, 0, 0, 1, 0, 0}, {0, 0, 0, 0, 1, 0}, {0, 0, 0, 0, 0, 1}, {0, 0, 0, 0, 0, 0}})), PlotStyle->PointSize[0.02],Method->"CircularEmbedding"]

(Subscript[R, max])[n_]:=n-1

while the minimal resistance—which requires a complete graph

GraphPlot[(({{0, 1, 1, 1, 1, 1}, {0, 0, 1, 1, 1, 1}, {0, 0, 0, 1, 1, 1}, {0, 0, 0, 0, 1, 1}, {0, 0, 0, 0, 0, 1}, {0, 0, 0, 0, 0, 0}})), PlotStyle->PointSize[0.02],Method->"CircularEmbedding"]

—has been shown elsewhere ("Resistors on Complete Graphs.nb", 15 November 2011) to be

(Subscript[R, min])[n_]:=(2/n)

Here I display the n-dependence of those functions:

ListPlot[Join[{Null},Table[(Subscript[R, max])[n],{n,2,30}]],PlotStyle->PointSize[0.02],PlotLabel->"n-dependence of (Subscript[R, max])"]
ListPlot[Join[{Null},Table[(Subscript[R, min])[n],{n,2,30}]],PlotRange->{0,1.04},PlotStyle->PointSize[0.02],PlotLabel->"n-dependence of (Subscript[R, min])"]

The (n-1) edges that are required to create a minimally-connected n-node graph can be linked up in (n-1)! ways:

One can identify the set of all n-node graphs (no self-connections, no more than one link between any nodal pair) with the set of n × n matrices

(({{0, \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder]}, {0, 0, \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder]}, {0, 0, 0, \[Placeholder], \[Placeholder], \[Placeholder]}, {0, 0, 0, 0, \[Placeholder], \[Placeholder]}, {0, 0, 0, 0, 0, \[Placeholder]}, {0, 0, 0, 0, 0, 0}}))

in which 0 else 1 are inserted into the □s in all possible ways. The number of □s is the triangular number

Δ[n_]:=(1/2)n(n-1)

so the total number of n-node graphs is

TotalGraphs[n_]:=(2^(Δ[n]))

which grows very rapidly:

Table[{n,TotalGraphs[n]},{n,2,10}]//TableForm

A collection of m resistors can be deposited on an n-node array (graph) in this many ways:

SubtotalGraphs[n_,m_]:=Binomial[Δ[n],m]

Connectivity requires

—requires, that is to say, optimal use of at least n-1 resistors.

Table[SubtotalGraphs[3,m],{m,2,Δ[3]}]
Table[SubtotalGraphs[4,m],{m,3,Δ[4]}]
Table[SubtotalGraphs[5,m],{m,4,Δ[5]}]
Table[SubtotalGraphs[6,m],{m,5,Δ[6]}]

The number of possible subgraphs becomes maximal at (1/2)Δ[n]. In the case n = 6, where
Δ[6] = 15, we have the following figure:

Table[{m,SubtotalGraphs[6,m]},{m,5,Δ[6]}];
ListPlot[%,PlotStyle->PointSize[0.02],AxesOrigin->{0,0}]

It is clear that n does not have to be very large for it to become no longer feasible to contemplate complete populations of graphs. Sampling procedures of some sort will have to be devised. There are, however, lessons to be learned from surveys of complete populations when n is small.

3-node graphs

This is the smallest not-quite-trivial case. I discuss it in detail to illustrate some methodological points which will acquire increasing importance as n becomes larger (but will seem extravagant in this instance), and to provide a context within which to formulate an interpretive distinction.

Case m = 0

This is trivial by any measure.

Case m = 1

The "connection matrices" are

(({{0, 1, 0}, {0, 0, 0}, {0, 0, 0}})),(({{0, 0, 1}, {0, 0, 0}, {0, 0, 0}})),(({{0, 0, 0}, {0, 0, 1}, {0, 0, 0}}))

which give

(Subscript[g31, 1])=GraphPlot[(({{0, 1, 0}, {0, 0, 0}, {0, 0, 0}})),VertexLabeling->True]
(Subscript[g31, 2])=GraphPlot[(({{0, 0, 1}, {0, 0, 0}, {0, 0, 0}})),VertexLabeling->True]
(Subscript[g31, 3])=GraphPlot[(({{0, 0, 0}, {0, 0, 1}, {0, 0, 0}})),VertexLabeling->True]

Those three graphs are permutationally equivalent, but give unequal readings if we suppose that our ohmmeter is attached always to (say) nodes #1 and #2. Each is a disconnected graph, so a graph to which the Klein-Randić method does not pertain: its application in the latter instance leads to a result

𝔸=(({{0, 0, 0}, {0, 0, 1}, {0, 0, 0}}))+Transpose[(({{0, 0, 0}, {0, 0, 1}, {0, 0, 0}}))];
𝔻=DiagonalMatrix[Table[Total[𝔸[[k]]],{k,1,3}]];
𝕃=𝔻-𝔸;
Γ=PseudoInverse[N[𝕃]];𝕎=Table[(Subscript[R, effective])[i,j],{i,1,3},{j,1,3}];
𝕎//MatrixForm

which is incorrect, but which differs from the correct internodal resistance matrix

(({{0, ∞, ∞}, {∞, 0, 1}, {∞, 1, 0}}))

in a patterned way. One would have to dig into the bowels of the PseudoInverse construction to discover how K-R came up with that

(1/4)//N

It is possible but meaningless to construct (as in work cited in my Introduction I allowed myself to do)

"K-R mean internodal resistance"=((0.25+0.25+1.0)/3)

and impossible to assign finite meaning to the "correct"

"mean internodal resistance"=((∞+∞+1.0)/3)

Case m = 2

The connection matrices are

(({{0, 1, 1}, {0, 0, 0}, {0, 0, 0}})),(({{0, 1, 0}, {0, 0, 1}, {0, 0, 0}})),(({{0, 0, 1}, {0, 0, 1}, {0, 0, 0}}))

which give

(Subscript[g32, 1])=GraphPlot[(({{0, 1, 1}, {0, 0, 0}, {0, 0, 0}})),VertexLabeling->True]
(Subscript[g32, 2])=GraphPlot[(({{0, 1, 0}, {0, 0, 1}, {0, 0, 0}})),VertexLabeling->True]
(Subscript[g32, 3])=GraphPlot[(({{0, 0, 1}, {0, 0, 1}, {0, 0, 0}})),VertexLabeling->True]

Those three graphs are again permutationally equivalent, and again give unequal readings if we suppose that our ohmmeter is attached always to (say) nodes #1 and #2. Each is now a connected graph, a graph to which the Klein - Randić method now does pertain : its application in the latter instance leads to a result

𝔸=(({{0, 0, 1}, {0, 0, 1}, {0, 0, 0}}))+Transpose[(({{0, 0, 1}, {0, 0, 1}, {0, 0, 0}}))];
𝔻=DiagonalMatrix[Table[Total[𝔸[[k]]],{k,1,3}]];
𝕃=𝔻-𝔸;
Γ=PseudoInverse[N[𝕃]];𝕎=Table[(Subscript[R, effective])[i,j],{i,1,3},{j,1,3}];
𝕎//MatrixForm

which clearly is correct.

Case m = 3

The solitary connection matrix in this "saturated" case is

(({{0, 1, 1}, {0, 0, 1}, {0, 0, 0}}))

which supplies

GraphPlot[(({{0, 1, 1}, {0, 0, 1}, {0, 0, 0}})),VertexLabeling->True]

𝔸=(({{0, 1, 1}, {0, 0, 1}, {0, 0, 0}}))+Transpose[(({{0, 1, 1}, {0, 0, 1}, {0, 0, 0}}))];
𝔻=DiagonalMatrix[Table[Total[𝔸[[k]]],{k,1,3}]];
𝕃=𝔻-𝔸;
Γ=PseudoInverse[N[𝕃]];𝕎=Table[(Subscript[R, effective])[i,j],{i,1,3},{j,1,3}];
𝕎//MatrixForm

which by

((((1/1)+(1/2)))^(-1))//N

is seen to be precisely correct.

4-node graphs

When one looks to all the graphs in which m is set to the minimal value that makes connectivity possible one finds that some graphs are connected but some are not. To illustrate the point I look to the smallest non-trivial case n = 4, m =3. The number of subgraphs in this instance is

SubtotalGraphs[4,3]

To assemble the relevant connection matrices

I construct 20 lists or 0s and 1s

P4=Permutations[{1,1,1,0,0,0}]
Length[%]

from which I snip segments—thus

{1,0,1,0,0,1}⟹{1,0,1}+{0,0}+{1}

—that I used to fill in the successive rows of □s in 𝕄. By this means, I construct a 20-member list of such connection matrices

Table[(Subscript[𝕄4, k])={Join[{0},Part[P4[[k]],1;;3]],
Join[{0,0},Part[P4[[k]],4;;5]],
Join[{0,0,0},Part[P4[[k]],6;;6]],
{0,0,0,0}},{k,1,20}];

and draw the resulting graphs:

Table[{k,GraphPlot[(Subscript[𝕄4, k]),PlotStyle->PointSize[0.05],Method->"CircularEmbedding"]},{k,1,20}]//TableForm

We see that the following four matrices give rise to disconnected graphs

(Subscript[𝕄4, 2])//MatrixForm
(Subscript[𝕄4, 6])//MatrixForm
(Subscript[𝕄4, 13])//MatrixForm
(Subscript[𝕄4, 20])//MatrixForm

and that all the other 𝕄4-matrices produce connected graphs. 

The four disconnected cases are permutationally equivalent, and when subjected (misguidedly) to K-R analysis give rise to the same pattern of error: K-R consistently writes 0.222222 where it should write ∞.  I note in this connection that

ContinuedFraction[.22222222,4]

leads to the construction

(1/(4+(1/(1+1))))
%//N

Again, one would have to dig into the bowels of the  PseudoInverse  to discover how K-R came up with that (2/9).

Case n = 4, m = 4

Proceding as before, we construct

P44=Permutations[{1,1,1,1,0,0}]
Length[%]

Table[(Subscript[𝕄44, k])={Join[{0},Part[P44[[k]],1;;3]],
Join[{0,0},Part[P44[[k]],4;;5]],
Join[{0,0,0},Part[P44[[k]],6;;6]],
{0,0,0,0}},{k,1,15}];

Table[{k,GraphPlot[(Subscript[𝕄44, k]),PlotStyle->PointSize[0.05],Method->"CircularEmbedding"]},{k,1,15}]//TableForm

and observe that all of those graphs are connected. They are of only four distinct types:

GraphPlot[(Subscript[𝕄44, 1]),VertexLabeling->True,Method->"CircularEmbedding"]
GraphPlot[(Subscript[𝕄44, 2]),VertexLabeling->True,Method->"CircularEmbedding"]
GraphPlot[(Subscript[𝕄44, 6]),VertexLabeling->True,Method->"CircularEmbedding"]
GraphPlot[(Subscript[𝕄44, 8]),VertexLabeling->True,Method->"CircularEmbedding"]

Those 4 designs are found …

𝔸=(Subscript[𝕄44, 1])+Transpose[(Subscript[𝕄44, 1])];
𝔻=DiagonalMatrix[Table[Total[𝔸[[k]]],{k,1,4}]];
𝕃=𝔻-𝔸;
Γ=PseudoInverse[N[𝕃]];𝕎=Table[(Subscript[R, effective])[i,j],{i,1,4},{j,1,4}];
𝕎//MatrixForm
((Total[Flatten[𝕎]])/(2Δ[4]))

𝔸=(Subscript[𝕄44, 2])+Transpose[(Subscript[𝕄44, 2])];
𝔻=DiagonalMatrix[Table[Total[𝔸[[k]]],{k,1,4}]];
𝕃=𝔻-𝔸;
Γ=PseudoInverse[N[𝕃]];𝕎=Table[(Subscript[R, effective])[i,j],{i,1,4},{j,1,4}];
𝕎//MatrixForm
((Total[Flatten[𝕎]])/(2Δ[4]))

𝔸=(Subscript[𝕄44, 6])+Transpose[(Subscript[𝕄44, 6])];
𝔻=DiagonalMatrix[Table[Total[𝔸[[k]]],{k,1,4}]];
𝕃=𝔻-𝔸;
Γ=PseudoInverse[N[𝕃]];𝕎=Table[(Subscript[R, effective])[i,j],{i,1,4},{j,1,4}];
𝕎//MatrixForm
((Total[Flatten[𝕎]])/(2Δ[4]))

𝔸=(Subscript[𝕄44, 8])+Transpose[(Subscript[𝕄44, 8])];
𝔻=DiagonalMatrix[Table[Total[𝔸[[k]]],{k,1,4}]];
𝕃=𝔻-𝔸;
Γ=PseudoInverse[N[𝕃]];𝕎=Table[(Subscript[R, effective])[i,j],{i,1,4},{j,1,4}];
𝕎//MatrixForm
((Total[Flatten[𝕎]])/(2Δ[4]))

((Total[Flatten[𝕎]])/(2Δ[4]))

…to give rise to internodal resistance matrices of only two basic types. The "mean internodal resistances" associated with those two types are found to be distinct.

Cases n = 4, m = 5 & 6

The graphs look like this:

GraphPlot[(({{0, 1, 1, 0}, {0, 0, 1, 1}, {0, 0, 0, 1}, {0, 0, 0, 0}})), PlotStyle->PointSize[0.04],Method->"CircularEmbedding"]
GraphPlot[(({{0, 1, 1, 1}, {0, 0, 1, 1}, {0, 0, 0, 1}, {0, 0, 0, 0}})), PlotStyle->PointSize[0.04],Method->"CircularEmbedding"]

Both are connected. I omit further discussion.

5-node graphs

There are, as previously remarked,

TotalGraphs[5]

such graphs, so exhaustive discussion—besides being relatively pointless—is pretty much out of the question. For m < 4 all graphs are disconnected, and it becomes impossible to speak of the mean internodal resistance (it is invariably ∞). I begin, therefore, with the least value of m for which connectedness is possible, if by no means inevitable:

Case n = 5, m = 4

We confront now a population of

SubtotalGraphs[5,4]

graphs, of which many will differ only permutationally from others. Reminding ourselves that

Δ[5]

we use

P54=Permutations[{1,1,1,1,0,0,0,0,0,0}];
Length[P54]

to proceed as before to the construction of 210 connection matrices and the associated graphs:

Table[(Subscript[𝕄54, k])={Join[{0},Part[P54[[k]],1;;4]],
Join[{0,0},Part[P54[[k]],5;;7]],
Join[{0,0,0},Part[P54[[k]],8;;9]],
Join[{0,0,0,0},Part[P54[[k]],10;;10]],
{0,0,0,0,0}},{k,1,210}];

Table[{k,GraphPlot[(Subscript[𝕄54, k]),PlotStyle->PointSize[0.05],Method->"CircularEmbedding"]},{k,1,210}]//TableForm

I have—by tedious hand counting—determined that 85 of those graphs are disconnected (all of those are in fact binary) and the rest (125) connected. There is, however, a better way to go: The commands

WeakComponents[(Subscript[𝕄54, 1])]
WeakComponents[(Subscript[𝕄54, 2])]

inform us (as the eye confirms) that graph #1 is connected, #2 is binary (∴ disconnected).

Table[Length[WeakComponents[(Subscript[𝕄54, k])]],{k,1,210}];
Count[%,2]

By this count, slightly more

(85/210)//N

than 40% of the graphs in question are disconnected.

I look now to a couple of especially simple connected graphs, and observe that in both cases the computed internodal resistances are obviously correct. Observe also that in this first example the correctly averaged internodal resistance

differs markedly from the approximation

that I used in previous work…this because   DeleteDuplicates command removes—in addition to all but one of the 0s on the diagonal—all but one of such off-diagonal resistances that happen to be repeated.

𝔾=(Subscript[𝕄54, 1]);
GraphPlot[𝔾,VertexLabeling->True,Method->"CircularEmbedding"]
𝔸=𝔾+Transpose[𝔾];
𝔻=DiagonalMatrix[Table[Total[𝔸[[k]]],{k,1,5}]];
𝕃=𝔻-𝔸;
Γ=PseudoInverse[N[𝕃]];𝕎=Table[(Subscript[R, effective])[i,j],{i,1,5},{j,1,5}];
𝕎//MatrixForm
((Total[Flatten[𝕎]])/(2Δ[5]))
Mean[DeleteDuplicates[Flatten[𝕎]]]

In this next example the commands

happen—fortuitously—to give the same result:

𝔾=(Subscript[𝕄54, 73]);
GraphPlot[𝔾,VertexLabeling->True,Method->"CircularEmbedding"]
𝔸=𝔾+Transpose[𝔾];
𝔻=DiagonalMatrix[Table[Total[𝔸[[k]]],{k,1,5}]];
𝕃=𝔻-𝔸;
Γ=PseudoInverse[N[𝕃]];𝕎=Table[(Subscript[R, effective])[i,j],{i,1,5},{j,1,5}];
𝕎//MatrixForm
((Total[Flatten[𝕎]])/(2Δ[5]))
Mean[DeleteDuplicates[Flatten[𝕎]]]

The Klein-Randić method, when applied to the following "irregular" connected graph, gives internodal resistances which are again obviously correct:

𝔾=(Subscript[𝕄54, 187]);
GraphPlot[𝔾,VertexLabeling->True,Method->"CircularEmbedding"]
𝔸=𝔾+Transpose[𝔾];
𝔻=DiagonalMatrix[Table[Total[𝔸[[k]]],{k,1,5}]];
𝕃=𝔻-𝔸;
Γ=PseudoInverse[N[𝕃]];𝕎=Table[(Subscript[R, effective])[i,j],{i,1,5},{j,1,5}];
𝕎//MatrixForm
((Total[Flatten[𝕎]])/(2Δ[5]))
Mean[DeleteDuplicates[Flatten[𝕎]]]

The Klein-Randić method clearly speaks nonsense, however, when brought to bear disconnected graphs such as the following:

𝔾=(Subscript[𝕄54, 42]);
GraphPlot[𝔾,VertexLabeling->True,Method->"CircularEmbedding"]
𝔸=𝔾+Transpose[𝔾];
𝔻=DiagonalMatrix[Table[Total[𝔸[[k]]],{k,1,5}]];
𝕃=𝔻-𝔸;
Γ=PseudoInverse[N[𝕃]];𝕎=Table[(Subscript[R, effective])[i,j],{i,1,5},{j,1,5}];
(Subscript[𝕎, KRdisconnected])=MatrixForm[𝕎]

Elementary analysis indicates that the correct result in this instance reads

(Subscript[𝕎, correct])=(({{0, (2/3), ∞, (2/3), ∞}, {(2/3), 0, ∞, (2/3), ∞}, {∞, ∞, 0, ∞, 1}, {(2/3), (2/3), ∞, 0, ∞}, {∞, ∞, 1, ∞, 0}}))//N//MatrixForm

When the Klein-Randić method is applied to connected fragments of the graph it again supplies correct results, as I demonstrate:

𝔾=(({{0, 1, 1}, {0, 0, 1}, {0, 0, 0}}));
GraphPlot[𝔾,VertexLabeling->True,Method->"CircularEmbedding"]
𝔸=𝔾+Transpose[𝔾];
𝔻=DiagonalMatrix[Table[Total[𝔸[[k]]],{k,1,3}]];
𝕃=𝔻-𝔸;
Γ=PseudoInverse[N[𝕃]];𝕎=Table[(Subscript[R, effective])[i,j],{i,1,3},{j,1,3}];
𝕎//MatrixForm

Comparison of

(Subscript[𝕎, disconnected])

and

(Subscript[𝕎, correct])

we see that the errors in the former conform to a very simple and regular pattern: teh K-R method has systematically written 0.472222 where it should have written ∞, and in all other particulars is correct.

Drawing again uon a procedure employed already once before, we command

ContinuedFraction[.472222222,4]

to obtain

(1/(2+(1/(8+(1/2)))))

N[%,10]

Increasing likelihood of connectedness

We have seen that, for a 5-node graph, connectedness—impossible if m < 4—stands already at

(125/210)100//N

% as soon as it becomes possible (at m = 5). We expect it to increase as m ranges upward from 5 toward,

Δ[5]

and ultimately to become inevitable.

P54=Permutations[{1,1,1,1,0,0,0,0,0,0}];

Table[(Subscript[𝕄54, k])={Join[{0},Part[P54[[k]],1;;4]],
Join[{0,0},Part[P54[[k]],5;;7]],
Join[{0,0,0},Part[P54[[k]],8;;9]],
Join[{0,0,0,0},Part[P54[[k]],10;;10]],
{0,0,0,0,0}},{k,1,Length[P54]}];

Table[Length[WeakComponents[(Subscript[𝕄54, k])]],{k,1,Length[P54]}];
Count[%,2];

(Subscript[Likelihood, 4])=100-100 ((%)/(Length[P54]))//N

P55=Permutations[{1,1,1,1,1,0,0,0,0,0}];

Table[(Subscript[𝕄55, k])={Join[{0},Part[P55[[k]],1;;4]],
Join[{0,0},Part[P55[[k]],5;;7]],
Join[{0,0,0},Part[P55[[k]],8;;9]],
Join[{0,0,0,0},Part[P55[[k]],10;;10]],
{0,0,0,0,0}},{k,1,Length[P55]}];

Table[Length[WeakComponents[(Subscript[𝕄55, k])]],{k,1,Length[P55]}];
Count[%,2];

(Subscript[Likelihood, 5])=100-100 ((%)/(Length[P55]))//N

P56=Permutations[{1,1,1,1,1,1,0,0,0,0}];

Table[(Subscript[𝕄56, k])={Join[{0},Part[P56[[k]],1;;4]],
Join[{0,0},Part[P56[[k]],5;;7]],
Join[{0,0,0},Part[P56[[k]],8;;9]],
Join[{0,0,0,0},Part[P56[[k]],10;;10]],
{0,0,0,0,0}},{k,1,Length[P56]}];

Table[Length[WeakComponents[(Subscript[𝕄56, k])]],{k,1,Length[P56]}];
Count[%,2];

(Subscript[Likelihood, 6])=100-100 ((%)/(Length[P56]))//N

P57=Permutations[{1,1,1,1,1,1,1,0,0,0}];

Table[(Subscript[𝕄57, k])={Join[{0},Part[P57[[k]],1;;4]],
Join[{0,0},Part[P57[[k]],5;;7]],
Join[{0,0,0},Part[P57[[k]],8;;9]],
Join[{0,0,0,0},Part[P57[[k]],10;;10]],
{0,0,0,0,0}},{k,1,Length[P57]}];

Table[Length[WeakComponents[(Subscript[𝕄57, k])]],{k,1,Length[P57]}];
Count[%,2];

(Subscript[Likelihood, 7])=100-100 ((%)/(Length[P57]))//N

P58=Permutations[{1,1,1,1,1,1,1,1,0,0}];

Table[(Subscript[𝕄58, k])={Join[{0},Part[P58[[k]],1;;4]],
Join[{0,0},Part[P58[[k]],5;;7]],
Join[{0,0,0},Part[P58[[k]],8;;9]],
Join[{0,0,0,0},Part[P58[[k]],10;;10]],
{0,0,0,0,0}},{k,1,Length[P58]}];

Table[Length[WeakComponents[(Subscript[𝕄58, k])]],{k,1,Length[P58]}];
Count[%,2];

(Subscript[Likelihood, 8])=100-100 ((%)/(Length[P58]))//N

ListPlot[{0,0,0,(Subscript[Likelihood, 4]),(Subscript[Likelihood, 5]),(Subscript[Likelihood, 6]),(Subscript[Likelihood, 7]),(Subscript[Likelihood, 8]),100,100},PlotStyle->PointSize[0.02],AxesLabel->{"m","Connectedness Likelihood"},GridLines->{{4},{100}}]

If I had more patience/motivation I might construct a similar plot for a 10-node graph

Δ[10]

but—as the following table makes clear

Table[{m,SubtotalGraphs[10,m]},{m,9,Δ[10]}]//TableForm

—one would have to forego exhaustive enumeration, would have to resort to some kind of fair sampling procedure. 

Here I have examined the case

Table[{m,SubtotalGraphs[5,m]},{m,4,Δ[5]}]//TableForm

It is remarkable that such a small adjustment as 5⟶10 can turn a tractable problem into a monster. But compare

(2^(Δ[5]))
(2^(Δ[10]))

The adjustment 5⟶10 inflates the problem by the following factor:

((2^(Δ[10]))/(2^(Δ[5])))

(2^(Δ[10]-Δ[5]))

Development of a "connectedness filter"

If I am, for the reason just touched upon, forced to construct my connection matrices (graphs) not by exhaustive enumeration but randomly, then I will stand in need of means to discard unconnected graphs. To that end I introduce a command

CompletenessFilter[M_]:=If[Length[WeakComponents[M]]≠1,0,M]

that is intended to accept (commection) matrices as arguments. To illustrate how this command works, I borrow from preceding work the matrices

(Subscript[𝕄, 1])={{0,1,1,1},{0,0,0,0},{0,0,0,0},{0,0,0,0}};
(Subscript[𝕄, 2])={{0,1,1,0},{0,0,1,0},{0,0,0,0},{0,0,0,0}};

of which the first generates a connected 4-node graph, the second an unconnected graph:

GraphPlot[(Subscript[𝕄, 1]),PlotStyle->PointSize[0.05],Method->"CircularEmbedding"]
GraphPlot[(Subscript[𝕄, 2]),PlotStyle->PointSize[0.05],Method->"CircularEmbedding"]

The complete/uncomplete distinction is now exposed

CompletenessFilter[(Subscript[𝕄, 1])]
CompletenessFilter[(Subscript[𝕄, 2])]

CompletenessFilter[(Subscript[𝕄, 1])]===(Subscript[𝕄, 1])
CompletenessFilter[(Subscript[𝕄, 2])]===(Subscript[𝕄, 2])

I now reconstruct a previous list of 4-node matrices

P4=Permutations[{1,1,1,0,0,0}];

RawMatrixSet=Table[(Subscript[𝕄4, k])={Join[{0},Part[P4[[k]],1;;3]],
Join[{0,0},Part[P4[[k]],4;;5]],
Join[{0,0,0},Part[P4[[k]],6;;6]],
{0,0,0,0}},{k,1,20}];

That is a list of

Length[RawMatrixSet]

matrices of which we know from previous work that 4 generate unconnected graphs. The command

DistilledMatrixSet=Table[CompletenessFilter[RawMatrixSet[[k]]],{k,1,20}];

Length[DistilledMatrixSet]

converts those matrices to place-holding zeros, which the following command discards:

FilteredMatrixList=DeleteCases[DistilledMatrixSet,0];

Length[FilteredMatrixList]

We verify that each of the surviving matrices (elements of the filtered list) is connected:

Table[Length[WeakComponents[FilteredMatrixList[[k]]]], {k,1,Length[FilteredMatrixList]}]

Length[%]

We could, by similar means, isolate bi-connected, tri-connected … graphs if we had interest in them.

Return to the percolation problem that first motivated this work

We must be clear about (1) what it is we propose to measure (resistance vs. conductance) and (2) how we propose to conduct those measurements. In all cases, we propose to drop m unit resistors onto an n-node graph, with m ranging from 1 to Δ[n].

I illustrate the alternatives as they relate to the simplest possible non-trivial case n =  3 (m = 1, 2, 3). I use ● to indicate nodes, and ● to indicate nodes to which the ohmmeter probes are connected.

Fixed probe protocol

Clip the meter probes to a selected pair of nodes. Drop a resistor randomly, many times.

Read R = {1, ∞, ∞} with equal frequency. Note that

If, on the other hand, the meter is a conductance meter get

Now drop a 2nd resistor (many times).

Read R = {1, 1, 2} with equal frequency, giving

Notice that each of those graphs is connected, so yields to Klein-Randić analysis.

Finally, drop a 3rd resistor:

Read

((((1/1)+(1/2)))^(-1))

invariably, giving

Movable probe protocol

Connect a resistor to a selected pair of nodes. Measure all internodal resistances:

Get R = {1, ∞, ∞}, giving again

Now install a 2nd resistor

and measure all internodal resistances; again get R = {1, 1, 2} giving

Notice again that each of those graphs is connected, so yields to Klein-Randić analysis.

Finally, install the 3rd resistor

and, proceeding as before, recover

The Fixed Probe Protocol requires investment in the construction of many m-resistor circuits. Exhaustive survey of the possibilities becomes impossible if n is large enough to be interesting; one must in such cases resort to statistical sampling. The K-R method can be used to evaluate

(Subscript[R, effective])[a,b]:=Γ[[a]][[a]]+Γ[[b]][[b]]-2Γ[[a]][[b]]

only if the probe nodes a & b are members of an identifiable connected subgraph.

The Movable Probe Protocol enables one to extract maximal data from each randomly constructed m-resistor circuit. The K-R method is subject to the same limitation as before, but it permits one to evaluate and average internodal resistances in subcircuit-wide batches. 

One must, in all events, identify connected subcircuits before attempting to exploit the K-R method. This I failed to do in "Percolation Expereiments 1 & 2." For m not too small one can expect most/all randomly constructed circuits to be connected,  so one can have fair confidence in the descending tail of the figures such as the following:

But when m is small the connectedness requirement is frequently violated, and the K-R method reports faulty numbers.

Relationship between "effective conductance" and "mean conductance"

We encountered in the preceding discussion a situation

that gave

Notice that  (Subscript[C, mean])[3,2]≠1/(Subscript[R, mean])[3,2], and more particularly that

Or—to say the same thing another way—

This is a particular instance of the assertion

which—phrased

—is classic. See

Hyperlink["Inequalities","http://en.wikipedia.org/wiki/Inequality_(mathematics)"]

The (p^th) power mean

—see

Hyperlink["Power Mean","http://en.wikipedia.org/wiki/Power_mean"]

—gives back the arithmetic and harmonic means as special cases, and is known to give rise to the generalized inequality

((((1/n)(∑_(i=1)^n)((Subscript[x, i])^q)))^q)≥((((1/n)(∑_(i=1)^n)((Subscript[x, i])^p)))^p)   :   q > p

Our immediate interest attaches to the cases q = 1 > p = -1. We have

with equality iff all resistances/conductances are the same.